home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-04-13 | 48.2 KB | 1,333 lines | [TEXT/MPS ] |
- unit TransExample;
-
- (*
- *_____________________________________________________________________
- *
- * File: Example.p
- *
- * Copyright 1986,1987 by Apple Computer, Inc. All Rights Reserved.
- *_____________________________________________________________________
- *
- * Example translator between Macintosh, ProDOS, and MS-DOS.
- *
- * Written by Karl B. Young
- *
- *_____________________________________________________________________
- *
- * Revision History
- *
- * 16-Jul-87 1.0A1 New today
- *_____________________________________________________________________
- *
- *
- *_____________________________________________________________________
- *)
- { This translator opens up the resource fork of a Macintosh file and copies *
- * all resources of the type STR# to a text file on any of the file systems. *
- * If the translation is Mac to Mac a dialog box is available to set the *
- * creator type of the text file (to open it just double click on it ). *
- * Note that this dialog box is only available when the translator is in the *
- * Mac to Mac menu, in the other menus it will not appear since Mac creator *
- * types have no meaning in the other file systems. Also notice how this *
- * translator protects itself from being loaded into menus in which it has no*
- * usefulness. *}
- INTERFACE
-
- USES
- {$LOAD MacLoad.L} MemTypes,QuickDraw,osIntf,toolIntf,packIntf,macPrint,script,
- {$LOAD } AFETrans;
- { AFETrans contains all of the standard AFE data structure definitions }
-
- { This is the function through which AFE communicates with the translator }
- function TranStr(Message : integer; VAR TranslateData : Handle;
- Param : longint; Self : handle) : longint;
-
- IMPLEMENTATION
- {$R-}
-
- CONST
-
- {************************************************************************
- * *
- * constants for strings (for error messages) *
- * the order of these strings is the same as in Example.r *
- * *
- ***********************************************************************}
- str_error = 1; { "An error occurred while " }
- str_creating = 2; { "creating the destination file: " }
- str_opensrc = 3; { "opening the source file: " }
- str_opendst = 4; { "opening the destination file: " }
- str_getfinfo = 5; { "getting information about the file: " }
- str_setfinfo = 6; { "setting the file type of the destination file: " }
- str_reading = 7; { "reading in the source file: " }
- str_writing = 8; { "writing out the destination file: " }
- str_copying = 9; { "Copying STR# resources…" }
- str_initing = 10; { "initializing the translator " }
- str_period = 11; { "." }
- str_cant = 12; { "It cannot translate from " }
- str_to = 13; { " to " }
- str_delsrc = 14; { "deleting the original file (your translated data is in the file $$$AFE-TEMP$$$): " }
- str_rendst = 15; { "renaming the destination file (your translated data is in the file $$$AFE-TEMP$$$): "}
- str_numstrings = 16; { "Number of STR# resources in this file: " }
- str_stringRes = 17; { "String Resource number " }
-
- {************************************************************************
- * *
- * constants for dialog box *
- * these are the item numbers for the objects in the options dialog box *
- * *
- ***********************************************************************}
- d_OK = 1;
- d_Cancel = 2;
- d_text = 3;
- d_MWradio = 4;
- d_MSWradio = 5;
- d_MPWradio = 6;
- d_MDSradio = 7;
- d_otherRadio = 8;
- d_MWicon = 9;
- d_MSWicon = 10;
- d_MPWicon = 11;
- d_MDSicon = 12;
- d_otherText = 13;
-
- {************************************************************************
- * *
- * Miscellaneous Constants *
- * *
- ***********************************************************************}
- tMCMC = 1; { Mac to Mac translation }
- tMCPD = 2; { Mac to ProDOS translation }
- tMCMS = 3; { Mac to MS-DOS translation }
-
- {************************************************
- * The following are offsets from the MacWrite *
- * button in the options dialog box *
- ************************************************}
- tMacWrite = 0; { MacWrite }
- tMSWord = 1; { Microsoft Word }
- tMPW = 2; { MPW }
- tMDS = 3; { MDS 68000 }
- tother = 4; { other }
-
- {************************************************
- * The following are creator names for the apps *
- * in the options dialog box *
- ************************************************}
- fMacWrite = 'MACA'; { MacWrite }
- fMSWord = 'MWRD'; { Microsoft Word }
- fMPW = 'MPS '; { MPW }
- fMDS = 'EDIT'; { MDS 68000 }
-
- fromFS = 0; { denotes the source file system }
- toFS = 1; { denotes the destination file system }
-
- TYPE
- {This data type is used to hold the File system nicknames, MC,MS,PD. }
- halfResType = packed array[1..2] of char;
-
- {*************** Global Variables record **************}
- StatusRec = RECORD
- mystatus : longint; { keeps the status bits for the translator,
- see discussion about TranData in the manual }
- myID : integer; { ID number of the STR# resource containing
- error strings }
- myfref : integer; { The file reference number for my resource file }
- trankind : integer; { The type of translation occurring, eg Mac to Mac}
- ftype : OSType; { The creator name for the destination file }
- fkind : integer; { the offset from the MacWrite dialog button }
- frHandle : Handle; { handle to the source file system resource }
- toHandle : Handle; { handle to the destination file system }
- srcsize : longint; { byte size of the source file }
- end;
- StatPtr = ^StatusRec;
- StatHndl = ^StatPtr;
-
- { Listing of all the functions in this unit }
- Function Activate(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
- Function CopyFile(srcref,dstref : integer; statRec : statHndl; trnPB : trnPtr) : OSErr; Forward;
- Function DoAppear(trnpb : trnptr; statRec : statHndl) : longint; Forward;
- Function DoFileConvert(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
- Function DoFinish(VAR translateData : handle) : OSErr; Forward;
- Function DoInit(VAR translateData,self : handle; trnpb : trnPtr) : longint; Forward;
- Function DoName(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
- Function FileIO(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl; trnPB : trnPtr) : OSErr; Forward;
- Function FileOp(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl; trnPB : trnPtr) : OSErr; Forward;
- Function GetStrSize(fref : integer) : longint; Forward;
- Function RecogFile(statRec : statHndl; trnPB : trnPtr) : longint; Forward;
- Procedure ReportErr(err,doing : integer; statRec : statHndl; trnPB : trnPtr); Forward;
-
-
- {*************************** Activate **************************************
- * Called when translator receives a trn_Activate.
- * ACTIVATE indicates that the user wishes to check this menu item. The *
- * routine does whatever it wants (usually just setting the appropriate bit *
- * in the flags, but it could be as complicated as a dialog box prompting *
- * the user for options), and then returns the new status flag as the *
- * function result. In this case Activate only puts up a dialog box if it is*
- * being activated in the Mac to Mac menu; otherwise it just updates the *
- * active bit in the status variable. *
- * Notice how the dialog box is only activated for the Mac to Mac trans- *
- * lation. For the other translation the we just set the active bit. *
- ***************************************************************************}
- Function Activate(statRec : statHndl; trnPB : trnPtr) : longint;
- var
- user_ptr : dialogPtr;
- cHndl : Controlhandle;
- itype : integer; { type of item in the dialog box,see Inside Mac
- vol I for details}
- iHndl : handle; { a handle to an item }
- irect : rect; { the display rectangle for the item }
- i : integer;
- str : str255;
- item : integer;
- curfkind : integer; { the current destination file type }
- oldres : integer;
- begin
- { if the translation is to prodos or msdos }
- if statrec^^.tranKind > tMCMC
- then statRec^^.mystatus := bor(trnActive,statRec^^.mystatus)
- else if statrec^^.tranKind = tMCMC then begin
- { if the translation is Mac to Mac than get the option dialog box }
- oldres := curResFile; { in case another resource file is being used }
- useResFile(statRec^^.myFref);
- user_ptr := getNewDialog(statRec^^.myID,nil,POINTER(-1));
- useResFile(oldres); { restore the old res file }
-
- { set up the file type }
- str := ' ';
- { check that the file type only consists of printable ascii characters }
- for i := 1 to 4 do begin
- if statRec^^.ftype[i] in [' '..'~']
- then str[i] := statRec^^.ftype[i];
- end;
- getDItem(user_ptr,d_otherText,itype,iHndl,iRect);
- setIText(iHndl,str);
-
- { set up the radio button }
- { get the previously selected file type, this is an offset from MacWrite}
- curfkind := statrec^^.fkind;
- { get a handle to that item }
- getDItem(user_ptr,d_MWradio+curfkind,itype,iHndl,iRect);
- cHndl := POINTER(iHndl);
- { turn the button to that item on }
- SetCtlValue(cHndl,1);
- { display the dialog box on the screen }
- showWindow(user_ptr);
-
- repeat
- { wait for a click in the dialog box }
- modalDialog(NIL,item);
- { if click anywhere except OK or Cancel }
- if item in [d_MWradio..d_otherText] then begin
- { if clicked on document icon calculate to which radio button }
- { it belongs. }
- if item >= d_MWicon then item := d_MWradio + (item - d_MWicon);
- { if the new choice is not the same as the old choice }
- if curfkind <> (item - d_MWradio) then begin
- { get a handle to the old item }
- getDItem(user_ptr,d_MWradio+curfkind,itype,iHndl,iRect);
- cHndl := POINTER(iHndl);
- { turn its radio button off }
- SetCtlValue(cHndl,0);
- { get a handle to the new item }
- getDItem(user_ptr,item,itype,iHndl,iRect);
- cHndl := POINTER(iHndl);
- { turn its radio button on }
- SetCtlValue(cHndl,1);
- { calculate the new offset from MacWrite }
- curfkind := item - d_MWradio;
- { if the Other radio button is not highlighted then put }
- { the apporiate creator type in the text box }
- if curfkind < tother then begin
- case curfKind of
- tMacWrite : str := fMacWrite;
- tMSWord : str := fMSWord;
- tMPW : str := fMPW;
- tMDS : str := fMDS;
- end;
- getDItem(user_ptr,d_otherText,itype,iHndl,iRect);
- SetIText(iHndl,str);
- end;
- end;
- end;
- until item in [d_OK,d_Cancel];
-
- if item = d_OK then begin
- { save the destination file type in the Global variable }
- statrec^^.fkind := curfKind;
- getDItem(user_ptr,d_otherText,itype,iHndl,iRect);
- GetIText(iHndl,str);
- { Make sure that the file type is four characters long }
- statrec^^.ftype := ' ';
- { Take only the first four characters of the file type }
- for i := 1 to 4 do begin
- if length(str) >= i
- then statrec^^.ftype[i] := str[i];
- end;
- { Set the Active bit in the status variable }
- statRec^^.myStatus := bor(statRec^^.myStatus,trnActive);
- end;
-
- DisposDialog(user_ptr);
- end;
- { Return the current translator status. }
- Activate := statRec^^.myStatus;
- end; { Activate }
-
- {* This is the function that actually does the translation of the STR# re- *
- * source to a text file.
- INPUT : srcref,dstref - file reference numbers for the source and destination
- file.
- datasize - the size of the source file
- statRec - the Global variable record.
- RESULT: The sucess or failure of the translation.
- USED by : DoFileConvert
- * Notice its use of tprocs to transliterate between the various character
- * sets used by the different file systems. Also notice that whenever tprocs
- * are called we make sure it is loaded in memory by using LoadResource, just
- * because we have a handle to it does not mean it resides currently in
- * memory because it is a purgeable resource.
- *}
- Function CopyFile(srcref,dstref : integer; statRec : statHndl; trnPB : trnPtr) : OSErr;
- var
- oldres : integer;
- numstr,numentries : integer;
- s,n : integer;
- hstr : handle;
- numptr : ^integer;
- str : str255;
- theID : integer;
- theType : ResType;
- theName : str255;
- datasize : longint;
- buf : array[0..511] of signedbyte;
- bufsize : integer;
- pb : ParamBlockRec;
- tpb : transPB;
- tproc : hdrHndl;
-
- {* This procedure finds the desired TProc for the transliteration
- * between the Mac and one of the other file systems and intializes it
- *}
- Procedure GetTProc;
- var
- tp : tprfHndl;
- found : boolean;
- entry : integer;
- i : integer;
- loCharSet,hiCharSet : integer;
- theverb : integer;
- theflag : integer;
- err : OSErr;
- begin
- tproc := NIL;
- { One doesn't need a Tproc if the translation involves only one
- computer type }
- if statrec^^.trankind = tMCMC then exit(GetTProc);
- { get a handle to the Tproc family for the given source country,
- if more than one trpf is available the user chooses which one to
- use from the country menu provided by AFE. }
- tp := POINTER(getResource('tprf',trnpb^.trncountry));
- if tp = NIL then exit(GetTProc);
- case statrec^^.tranKind of
- tMCPD : begin
- loCharSet := cfMacintosh;
- hiCharSet := cfASCII;
- theverb := transLotoHi;
- theflag := trNonOnetoOne;
- end;
- tMCMS : begin
- loCharSet := cfMacintosh;
- hiCharSet := cfIBMPC;
- theverb := transLotoHi;
- theflag := trNonOnetoOne;
- end;
- end;
- found := false;
- { Search through the whole tproc family for the one that translates
- between the two character families }
- for i := 1 to tp^^.lastentry do with tp^^.tprocs[i] do begin
- if altcountry = trnpb^.trncountry then
- if (curCharFam = loCharSet) and (altCharFam = hiCharSet) then begin
- found := true;
- entry := i;
- leave;
- end;
- end;
- if not found then exit(GetTProc);
- { Get a handle to the tproc specified by the tproc family entry }
- tproc := POINTER(GetResource('tprc',tp^^.tprocs[entry].tprcID));
- { exit if the resource cannot be found }
- if tproc = NIL then exit(GetTProc);
- { if not currently in memory thant load it now }
- if tproc^ = NIL then loadResource(POINTER(tproc));
- with tpb do begin
- featureflags := band(tproc^^.flags,theflag);
- newcntry := -1;
- { these fields are reserved set to zero }
- tpRsrv[0] := 0;
- tpRsrv[1] := 0;
- tpRsrv[2] := 0;
- tpRsrv[3] := 0;
- { initialize transliteration procedure }
- verb := transInit;
- err := CallTProc(tpb,tproc);
- if err <> noerr then begin
- tproc := NIL;
- exit(GetTProc);
- end;
- { the translations will be transLotoHigh }
- verb := theverb;
- end;
- end;
-
-
- {* This procedure send the source string to the Transliteration
- * procedure and returns the result in tpb.dstText.trPtr. The verb for
- * the translation was set in GetTProc.
- * OUTPUT : Bufsize is changed to be the size of the destination
- * buffer. It is used in WriteString.
- *}
- Procedure TranslitString(VAR str : str255);
- var
- err : OSErr;
- begin
- { if there is no tproc than just move the source buffer to the
- ioBuffer buffer }
- if tProc = NIL then begin
- blockmove(POINTER(ORD4(@str)+1),@buf,length(str));
- bufsize := length(str);
- end
- else begin
- tpb.srcText.trLen := length(str);
- { The first element of a string is its size, since we do not
- want to translate this character we set the buffer to the
- next one. }
- tpb.srcText.trPtr := POINTER(ORD4(@str)+1);
- tpb.srcText.trFont := 0;
- tpb.dstText.trLen := 512;
- tpb.dstText.trPtr := @buf;
- tpb.dstText.trFont := 0;
- {if the tproc is not in memory than load it }
- if tproc^ = NIL then loadResource(POINTER(tproc));
- err := CallTProc(tpb,tProc);
- bufsize := tpb.dstText.trLen;
- end;
- end;
-
- {* This procedure writes out a string to the destination file and adds
- * a carriage return if cr is true. It assumes that the string is
- * already pointed to by pb.ioBuffer using the assignment
- * pb.ioBuffer := @Buf. It also assumes that GetTProc has already been
- * called to get the required TProc.
- *}
- Procedure WriteString(str : str255; cr : boolean);
- var
- pct : integer;
- err : OSErr;
- begin
- { Use the tprocs to transliterate between character sets }
- TranslitString(str);
- pb.ioReqCount := bufsize;
- err := FileIO(FFWrite,tofs,@pb,statrec,trnpb);
- { add the carriage return to the destination file }
- if cr and (err = noerr) then begin
- buf[0] := 13; {carriage return}
- bufsize := 1;
- { if translating to an MSDOS disk a line feed is also needed to
- start a new line. }
- if statrec^^.tranKind = tMCMS then begin
- buf[1] := 10; { line feed }
- bufsize := 2;
- end;
- pb.ioReqCount := bufsize;
- err := FileIO(FFWrite,tofs,@pb,statrec,trnpb);
- end;
- { report any error that occurred while writing to the destination }
- if err <> noerr then begin
- reporterr(err,str_writing,statrec,trnpb);
- CopyFile := err;
- useResFile(oldres);
- exit(copyFile)
- end;
- { compute how much of the translation has been completed for
- display in the status window }
- datasize := datasize+length(str);
- pct := datasize * 100 div statrec^^.srcSize;
- if pct < 0 then pct := 0
- else if pct > 100 then pct := 100;
- { if user clicks on cancel }
- if not CallStat('',pct,1,trnpb^.trnStatProc) then begin
- CopyFile := trnCancel;
- useResFile(oldres);
- exit(copyFile);
- end;
- end;
-
- {* This procedure writes out the first line of the destination file
- * it tells how many strings there are to translate }
- Procedure Header(numstr : integer);
- var
- oldres : integer;
- str : str255;
- begin
- datasize := 0;
- GetTProc;
- pb.ioCompletion := NIL;
- pb.ioRefNum := dstref;
- pb.ioBuffer := @buf;
- pb.ioPosMode := fsAtMark;
- oldres := CurResFile;
- useResFile(statRec^^.myfref);
- GetIndString(str,statrec^^.myID,str_numstrings);
- WriteString(str,false);
- { convert the count of STR# resources to a string }
- NumToString(numstr,str);
- WriteString(str,true);
- useResFile(oldres);
- end;
-
- {* This procedure writes to the destination file a line stating the
- * string resource ID number
- *}
- Procedure HeaderString(s,theID,numentries : integer; theName : str255);
- var
- oldres : integer;
- str : str255;
- begin
- oldres := CurResFile;
- useResFile(statRec^^.myfref);
- { Insert a blank line }
- WriteString('',true);
- { Write the string 'String Resource Number ' }
- GetIndString(str,statrec^^.myID,str_stringRes);
- WriteString(str,false);
- { convert the resource ID number to a string }
- NumToString(theID,str);
- WriteString(str,true);
- { make the old resource the current one }
- useResFile(oldres);
- end;
-
- {* This procedure writes to the destination file one of the strings in
- * a STR# resource. It is called from the main body of CopyFile
- *}
- Procedure EntryString(str : str255; n : integer);
- var
- oldres : integer;
- str2 : str255;
- begin
- writeString(str,true);
- end;
-
- begin { Main body of CopyFile }
- { save the current resource file to restore later }
- oldres := CurResFile;
- useResFile(srcref);
- { get the number of STR# resources }
- numstr := count1Resources('STR#');
- { Write the number of STR# resources to the destination file }
- Header(numstr);
- for s := 1 to numstr do begin
- { get the sth resource from the source file }
- hstr := Get1IndResource('STR#',s);
- if hstr = NIL then leave;
- GetResInfo(hstr,theID,theType,theName);
- { make numptr point to the same place as the master pointer
- of the STR# resource. Since numptr is of a different type we
- use Pointer to avoid type conflicts. }
- numptr := POINTER(hstr^);
- { The first value in a STR# resource is the number of strings in
- the resource (an integer value). Since numptr is a ^integer, it
- is pointing to this value }
- numentries := numptr^;
- Headerstring(s,theID,numentries,theName);
- { get each string in the resource and write it to the destination
- file }
- for n := 1 to numentries do begin
- GetIndString(str,theID,n);
- EntryString(str,n);
- end;
- end;
- { if we have been using a tproc tell it that we have finished the
- translation }
- if tproc <> NIL then begin
- tpb.verb := transdone;
- if tproc^ = NIL then loadresource(POINTER(tproc));
- if CallTProc(tpb,tproc) <> noerr then ;
- end;
- useResFile(oldres);
- CopyFile := noerr;
- end; { CopyFile }
-
-
- {******************************* DoAppear *******************************
- * DoAppear is called in response to a trn_APPEAR message which occurs when *
- * a new disk has been selected which has caused this routine to appear in *
- * its menu. We do not change appearance in the menu, except to clear any *
- * gray bits that may have been set. Returns NoErr as function result. *
- * Some functions may use this procedureto define some global data *
- * (such as source or destination FS, etc ). *
- * Notice how the grey bit is turned off. First we create this bit value *
- * with all the bits except for the grey bit on (-1 = $FFFFFFFF) Then we *
- * bit and this with the current status, any high bits in the current *
- * status remain high and none that are not are activated. This is called *
- * masking, and is the most effecient method for changing individual status *
- * bits. *
- ***************************************************************************}
- Function DoAppear(trnpb : trnptr; statRec : statHndl) : longint;
- begin
- statRec^^.myStatus := band(statRec^^.myStatus,-1-trnGray);
- DoAppear := noErr;
- end; { DoAppear }
-
- {********************************** DoFileConvert ***************************
- * Called when the translator receives a trn_FILE. Result = Accept,unAccept, *
- * or Cancel. *
- * This function creates the necessary files for the translation to occur. *
- * The actual translation is done by another function CopyFile. *
- * Notice the care used in regards to duplicate file names, particularly the *
- * creation of an intermediate file when copying in place (ie replacing the *
- * source with the destination file).
- ****************************************************************************}
- Function DoFileConvert(statRec : statHndl; trnPB : trnPtr) : longint;
- var
- err,err2 : OSErr;
- srcopened,dstcreated,dstopened,tempfile : boolean;
- pb : HParamBlockRec;
- pbold,pbnew : WDPBRec;
- catpb : CInfoPBRec;
- srcref,dstref : integer;
- frstr,tostr : str255;
- str : str255;
- begin
- DoFileConvert := unaccept;
- { Note how we always use the same recognize for trn_File and trn_Recognize }
- if RecogFile(statRec,trnPB) = accept then begin
- DoFileConvert := accept;
- srcopened := false;
- dstcreated := false;
- dstopened := false;
- tempfile := false;
- tostr := trnPB^.trnnames^^.names[1]; { source file name }
- frstr := trnPB^.trnnames^^.names[0]; { destination file name }
- err := noerr;
- { create the destination file }
- if err = noerr then with pb do begin
- ioNamePtr := @tostr;
- pb.ioFVersNum := 0;
- err := FileOp(FFCreate,toFS,@pb,statrec,trnpb);
- { if the file already exists }
- if err = dupfNErr then begin
- { check to see if it is the source file }
- if (trnpb^.trnfrID = trnpb^.trntoID)
- and (trnpb^.trnfrVRef = trnpb^.trntoVRef)
- and (trnpb^.trnfrpar = trnpb^.trntopar)
- and (tostr = frstr) then begin
- { if it is then create a temporary file to hold the tran-
- slation }
- tostr := '$$$@FE-TEMP$$$';
- repeat
- { increment the fourth letter by one until we get }
- { a unique name for the temporary file }
- tostr[4] := CHR(ORD(tostr[4])+1);
- err := FileOp(FFCreate,toFS,@pb,statrec,trnpb);
- until err <> dupfNErr;
- { if another error occurred then do not translate }
- if err <> noerr then err := fBsyErr
- else tempfile := true;
- end
- { if the destination is not the same as the source then delete
- the current file and create a new destination file }
- else begin
- ioNamePtr := @tostr;
- ioFVersNum := 0;
- err2 := FileOp(FFDelete,toFS,@pb,statrec,trnpb);
- if err2 = noerr then begin
- ioNamePtr := @tostr;
- pb.ioFVersNum := 0;
- err := FileOp(FFCreate,toFS,@pb,statrec,trnpb);
- end;
- end;
- end;
- { if the last operation was successful then the destination file
- was created }
- if err = noerr
- then dstcreated := true
- else reportErr(err,str_creating,statRec,trnPB);
- end;
-
- { if a Mac to Mac translation }
- if statRec^^.trankind = tMCMC then begin
- {* Note: before doing a SetFInfo it is a good idea make sure that there is *
- * valid information in all param block fields so do a GetFInfo first *}
- if err = noerr then with catpb do begin
- ioNamePtr := @tostr;
- ioFDirIndex := 0;
- err := FileOp(FFGetFInfo,toFS,@catpb,statrec,trnpb);
- { If the destination gives a bad param block try the source }
- if err <> noerr then begin
- ioNamePtr := @frStr;
- ioFVersNum := 0;
- err := FileOp(FFGetFInfo,fromFS,@catpb,statrec,trnpb);
- err := noerr;
- end;
- end;
- { Set the destination file type and creator }
- if err = noerr then with catpb do begin
- ioNamePtr := @tostr;
- ioflFndrInfo.fdtype := 'TEXT';
- ioflFndrInfo.fdcreator := statrec^^.ftype;
- err := FileOp(FFSetFInfo,toFS,@catpb,statrec,trnpb);
- if err <> noerr then reportErr(err,str_setfinfo,statRec,trnPB);
- err := noerr;
- end;
- end;
- { For all file systems open the destination }
- if err = noerr then with pb do begin
- ioNamePtr := @tostr;
- if statrec^^.tranKind = tMCPD
- then ioPermssn := 0
- else ioPermssn := fsWrPerm;
- ioMisc := NIL;
- err := FileOp(FFOpen,toFS,@pb,statrec,trnpb);
- if err = noerr then begin
- dstopened := true;
- dstref := ioRefNum;
- end
- else reportErr(err,str_opendst,statRec,trnPB);
- end;
- { check to see if the file is already opened }
- if err = noerr then with catpb do begin
- ioNamePtr := @frstr;
- ioFVersNum := 0;
- ioFDirIndex := 0;
- err := FileOp(FFGetFInfo,fromFS,@catpb,statrec,trnpb);
- if err <> noerr then reportErr(err,str_getfinfo,statRec,trnPB);
- end;
- if (err = noerr) and (band(catpb.ioFlAttrib,$04) = 0) then with pb do begin
- pbold.ioCompletion := NIL;
- pbold.ioNamePtr := NIL;
- err := PBHGetVol(@pbold,false);
- if err = noerr then with pbnew do begin
- ioCompletion := NIL;
- ioNamePtr := NIL;
- ioVRefNum := trnpb^.trnfrvref;
- ioWDDirID := trnpb^.trnfrpar;
- err := PBHSetVol(@pbnew,false);
- end;
- if err = noerr then begin
- srcref := OpenResFile(trnpb^.trnNames^^.names[0]);
- err := PBHSetVol(@pbold,false);
- end;
- { if the resource fork of the source could not be opened then exit }
- if (err = noerr) and (srcref <= 0) then err := fnferr;
- if err = noerr then begin
- srcopened := true;
- end
- else reportErr(err,str_opendst,statRec,trnPB);
- end
- else if err = noerr then srcRef := catpb.ioFRefNum;
- { If opened destination get size of source strings, this value is saved in
- statrec^^.srcsize after opening the source file *}
- if err = noerr then with catpb do begin
- statrec^^.srcsize := GetStrSize(srcref);
- end;
-
- { If no errors so far then translate the file }
- GetIndString(str,statrec^^.myID,str_copying);
- if not CallStat(str,0,1,trnpb^.trnStatProc) then err := trnCancel;
- if err = noerr then err := copyFile(srcref,dstref,statrec,trnpb);
- if not CallStat('',100,1,trnpb^.trnStatProc) then err := trnCancel;
-
- { Close the files and erase any temporary files }
- if srcopened then with pb do begin
- CloseResFile(srcref);
- end;
- if dstopened then with pb do begin
- ioRefNum := dstref;
- err2 := FileIO(FFClose,tofs,@pb,statrec,trnpb);
- end;
- { If an error occurred during translation than delete the destination
- file, it is not valid }
- if (err <> noerr) and dstcreated then with pb do begin
- ioNamePtr := @tostr;
- ioFVersNum := 0;
- err2 := FileOp(FFDelete,toFS,@pb,statrec,trnpb);
- end;
- { if a translation in place was completed then delete the source and
- rename the destination with the source name }
- if (err = noerr) and tempfile then with pb do begin
- ioNamePtr := @frstr;
- ioFVersNum := 0;
- err2 := FileOp(FFDelete,toFS,@pb,statrec,trnpb);
- if err2 <> noerr then reportErr(err2,str_delsrc,statRec,trnPB);
- if err2 = noerr then begin
- ioNamePtr := @tostr;
- ioFVersNum := 0;
- ioMisc := @frstr;
- err2 := FileOp(FFRename,toFS,@pb,statrec,trnpb);
- if err2 <> noerr then reportErr(err2,str_rendst,statRec,trnPB);
- end;
- end;
- if err = trncancel then DoFileConvert := trnCancel;
- end;
- end; { DoFileConvert }
-
-
- {************************************** DoFinish ****************************
- * Called when transltor receives an trn_FINIS. *
- * DoFinish cleans up any global variables that might have been allocated. *
- * ALWAYS returns NoErr. It is only called when execution of AFE is *
- * terminated (ie. you hit quit ). *
- ***************************************************************************}
- Function DoFinish(VAR translateData : handle) : OSErr;
- begin
- DoFinish := noErr;
- if translateData <> NIL then disposHandle(translateData);
- translateData := NIL;
- end;
-
- {************************************** DoInit ******************************
- * Called whenever a translator receives a trn_INIT message. This happens *
- * when translators are imported to other menus as well as at startup. *
- * DoInit initializes the variables we need. It allocates a relocatable *
- * block of memory and puts the handle in translateData. It determines the *
- * source and dest file system and sets up the default parameters. It *
- * returns noErr if all goes well, and a negative result otherwise. *
- ***************************************************************************}
- Function DoInit(VAR translateData,self : handle; trnpb : trnPtr) : longint;
- var
- theID : integer; theType : restype; namefr,nameto,myname : str255;
- str : str255;
- dstnick,srcnick : halfResType;
- err : OSErr;
- statRec : StatHndl;
- kind : integer;
- srcHandle,dstHandle : handle;
- len : integer;
- thefref : integer;
- begin
- {* get handles of source and dest file systems
- * Note: GetResource returns NoErr even if it does not find the
- * resource. This is why one must check for NIL handles as well as
- * ResError.}
- srcHandle := GetResource(foreignFS,trnpb^.trnfrID);
- err := ResError;
- if (err = noErr) and (srcHandle = NIL) then err := resNotFound;
- if err = noerr then begin
- dstHandle := GetResource(foreignFS,trnpb^.trntoID);
- err := ResError;
- if (err = noErr) and (dstHandle = NIL) then err := resNotFound;
- end;
-
- {* get nickname of source file system = The last two characters of
- * the file system name; MC, MS, PD. }
- if err = noerr then begin
- GetResInfo (srcHandle, theID, theType, namefr);
- err := ResError;
- end;
- if err = noErr then begin
- len := length(namefr);
- if len <= 2 then err := bdNamErr;
- end;
- if err = noErr then begin
- srcnick[1] := namefr[len-1]; srcnick[2] := namefr[len];
- if (srcnick <> 'PD') and (srcnick <> 'MS') and (srcnick <> 'MC')
- then err := extFSErr;
- end;
-
- {* get nickname of destination file system *}
- if err = noerr then begin
- GetResInfo (dstHandle, theID, theType, nameto);
- err := ResError;
- end;
- if err = noErr then begin
- len := length(nameto);
- if len <= 2 then err := bdNamErr;
- end;
- if err = noErr then begin
- dstnick[1] := nameto[len-1]; dstnick[2] := nameto[len];
- if (dstnick <> 'PD') and (dstnick <> 'MS') and (dstnick <> 'MC')
- then err := extFSErr;
- end;
-
- {* get information about translator. Keeping the file reference number
- * allows one to switch the resource file in use to one's own if it is
- * not the current one.
- *}
- if err = noerr then begin
- getResInfo(self,theID,thetype,myname);
- err := ResError;
- end;
- if err = noerr then begin
- theFRef := homeResFIle(self);
- err := ResError;
- end;
-
- {* determine kind of translation. This translator only supports tran-
- * slation from the Macintosh file system. If we are not in one of these
- * menus then generate an error.
- *}
- if err = noErr then begin
- if (srcnick='MC') and (dstnick = 'MC') then kind := tMCMC
- else if (srcnick='MC') and (dstnick = 'PD') then kind := tMCPD
- else if (srcnick='MC') and (dstnick = 'MS') then kind := tMCMS
- else err := extFSerr;
- end;
-
- {* get global data space. Why do we make statrec a pointer to handle can
- you even do this?!? *}
- if err = noErr then begin
- translateData := NewHandle(sizeof(statusRec));
- statrec := POINTER(translateData);
- err := MemError;
- end;
-
- {* set up default settings *}
- if err = noErr then with statRec^^ do begin
- { Check menu item (make it active) and set the About bit }
- myStatus := trnActive + trnAbout;
- { the ID number of the translator resource }
- myID := theID;
- { the file reference number of the translator file }
- myFref := theFref;
- { the type of translation (Mac to Mac, etc.) }
- trankind := kind;
- { default file type is MacWrite }
- ftype := 'MACA';
- { default translation is into a MacWrite file }
- fkind := tMacWrite;
- { Handles to the source and destination file system (resources). }
- frHandle := srcHandle;
- toHandle := dstHandle;
- end;
-
- if err <> noerr then begin
- GetIndString(str,theID,str_error);
- CallErrLog(str,false,false,trnpb^.trnlogproc);
- GetIndString(str,theID,str_initing);
- CallLog(str,false,false,trnPB^.trnlogproc);
- CallLog(myname,false,false,trnPB^.trnlogproc);
- GetIndString(str,theID,str_period);
- CallLog(str,true,false,trnPB^.trnlogproc);
- { If translator is not in a valid menu }
- if err = extFSerr then begin
- GetIndString(str,theID,str_cant);
- CallLog(str,false,false,trnPB^.trnlogproc);
- CallLog(copy(namefr,1,length(namefr)-2),false,false,trnPB^.trnlogproc);
- GetIndString(str,theID,str_to);
- CallLog(str,false,false,trnPB^.trnlogproc);
- CallLog(copy(nameto,1,length(nameto)-2),false,false,trnPB^.trnlogproc);
- GetIndString(str,theID,str_period);
- CallLog(str,true,false,trnPB^.trnlogproc);
- end;
- end;
-
- DoInit := err;
- end; { DoInit }
-
- {******************************* DoName ********************************
- * Called when the translator receives a trn_NEWNAME message *
- * trn_NEWNAME is passed a trnPTR in PARAM. It should check the file *
- * specified as the source and return either NOERR or UNACCEPT as the *
- * function result, depending on whether the file matches the criteria for *
- * acceptance by this routine (it can skip checking for acceptance if the *
- * trnTESTED field is true -- in that case, the trnACCEPTED field indicates *
- * whether this file was previously accepted). If acceptable, then *
- * trn_NEWNAME should return a suggested new name for the destination file, *
- * and set the field trnNAMES.NAMECNT to 1. On those occasions when more *
- * than one destination file will be produced, the name handle should be *
- * expanded and trnNAMES.NAMECNT should be increased appropriately. *
- ***************************************************************************}
- Function DoName(statRec : statHndl; trnPB : trnPtr) : longint;
- var
- temp : longint;
- pb : HParamBlockRec;
- err : OSErr;
- str : str255;
- begin
- DoName := unaccept;
- if RecogFile(statRec,trnPB) = accept then begin
- str := trnpb^.trnNames^^.names[0];
- trnpb^.trnNames^^.NameCnt := 1;
- pb.ioNamePtr := @str;
- pb.ioDirID := trnpb^.trnToPar;
- pb.ioVRefNum := trnPb^.trnToVRef;
- err := FileOp(FFMakeFName,toFS,@pb,statrec,trnpb);
- if err = noerr then begin
- trnpb^.trnNames^^.names[1] := str;
- DoName := accept;
- end;
- end;
- end; { DoName }
-
- {******************************** FileIO *********************************
- * Called by CopyFile, DoFileConvert *
- * This is a utility function that does the repetitive actions for *
- * FFREAD, FFWRITE, and FFCLOSE. The Calling procedure provides: *
- * ioRefNum *
- * ioposMode†, ioposOffset† *
- * ioReqCount†, ioBuffer † *
- * *
- * † for READ and WRITE only *
- * *
- ***************************************************************************}
- Function FileIO(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl;
- trnPB : trnPtr) : OSErr;
- var
- err : OSErr;
- begin
- pb^.ioCompletion := NIL;
- err := noErr;
- if fs = fromFS
- then err := CallFS(ff,trnpb^.trnfrData,POINTER(pb),false,statrec^^.frHandle)
- else err := CallFS(ff,trnpb^.trntoData,POINTER(pb),false,statrec^^.toHandle);
- FileIO := err;
- end; { FileIO }
-
- {******************************** FileOp *********************************
- * Called by DoFileConvert, DoFileName, RecogFile *
- * for FFOPEN, FFGETFINFO, FFGETCATINFO, FFSETCATINFO, FFSETFINFO, FFRENAME,*
- * FFDELETE, FFCREATE, FFGETXCATINFO, FFSETXCATINFO, FFMAKEFNAME *
- * Calling procedure provides (in the pb variable): *
- * ioMisc,ioPermssn,ioNamePtr -- FFOPEN *
- * This function provides the part of the CallFS function that does not *
- * change for the calls listed above. It eliminates having to repeat it for *
- * every one of the calls. *
- ***************************************************************************}
- Function FileOp(ff,fs : integer; pb : HParmBlkPtr; statrec : StatHndl; trnPB : trnPtr) : OSErr;
- { ff = file system command, fs = source or destination file }
- var
- err : OSErr;
- begin
- with pb^ do begin
- ioCompletion := NIL;
- if fs = fromFS then begin
- ioVRefNum := trnpb^.trnfrVRef;
- ioDirID := trnpb^.trnfrPar;
- err := CallFS(ff,trnpb^.trnfrData,POINTER(pb),false,statrec^^.frHandle);
- end
- else begin { perfrom operation on the source file }
- ioVRefNum := trnpb^.trntoVRef;
- ioDirID := trnpb^.trntoPar;
- err := CallFS(ff,trnpb^.trntoData,POINTER(pb),false,statrec^^.toHandle);
- end;
- end;
- FileOp := err;
- end; { FileOp }
-
- Function GetStrSize(fref : integer) : longint;
- var
- oldres : integer;
- size : longint;
- h : handle;
- numstr,s : integer;
- begin
- oldres := curResFile;
- useResFile(fref);
- setResload(false);
- numstr := count1Resources('STR#');
- size := 0;
- for s := 1 to numstr do begin
- h := Get1IndResource('STR#',s);
- size := size + MaxSizeRsrc(h);
- end;
- setResLoad(true);
- useResFile(oldres);
- GetStrSize := size;
- end;
-
- {******************************** RecogFile *********************************
- * Called when trasnlator receives trn_Recognize. *
- * It is also called by DoName and DoFileConvert. *
- * RecogFile is passed a trnPTR and status record. It should check the file*
- * specified as the source and return either ACCEPT or UNACCEPT as the *
- * function result, depending on whether the file matches the criteria for *
- * acceptance by this routine. Notice how we do not log errors during that *
- * may occur in this function. We only want to know if this translator can *
- * translate this file or not, if it can't for any reason then we do not *
- * accept the file. *
- ***************************************************************************}
- Function RecogFile(statRec : statHndl; trnPB : trnPtr) : longint;
- var
- err : OSErr;
- pb : HParamBlockRec;
- pbnew,pbold : WDPBRec;
- temp : OSType;
- size,readsize : longint;
- fref, num : integer;
- srcopened : boolean;
- oldres : integer;
- begin
- {* check if the file's already been tested *}
- RecogFile := unaccept;
- if trnPB^.trnTested then begin
- if trnPB^.trnAccepted then RecogFile := accept;
- exit(RecogFile);
- end;
-
- {* check whether we have a resource fork or no *}
- pb.ioNamePtr := @trnpb^.trnNames^^.names[0];
- pb.ioFDirIndex := 0;
- err := FileOp(FFGetFInfo,fromFS,@pb,statrec,trnpb);
- if err <> noerr then exit(RecogFile); { don't log errors during recognition }
- if pb.ioFlRPyLen = 0 then exit(RecogFile);
-
- srcopened := false;
- if band(pb.ioFlAttrib,$04) = 0 then begin { if already opened, don't reopen }
- {* now we have to check things out via the resource manager *}
- {* first: set up the volume because the resource manager doesn't allow volume
- AND directory specification *}
- pbold.ioCompletion := NIL;
- pbold.ioNamePtr := NIL;
- err := PBHGetVol(@pbold,false);
- if err <> noerr then exit(RecogFile);
- with pbnew do begin
- ioCompletion := NIL;
- ioNamePtr := NIL;
- ioVRefNum := trnpb^.trnfrvref;
- ioWDDirID := trnpb^.trnfrpar;
- err := PBHSetVol(@pbnew,false);
- if err <> noerr then exit(RecogFile);
- end;
- fref := OpenResFile(trnpb^.trnNames^^.names[0]);
- err := PBHSetVol(@pbold,false);
- { if the resource fork of the source could not be opened then exit }
- if fref <= 0 then exit(RecogFile);
- srcopened := true;
- end
- else fref := pb.ioFRefNum;
- oldres := CurResFile;
- useResFile(fref);
- num := count1Resources('STR#');
- useResFile(oldres);
- if num > 0
- then RecogFile := accept;
- if srcopened then begin
- CloseResFile(fref);
- end;
-
- end; { RecogFile }
-
- {******************************** ReportErr *********************************
- * Called whenever an error occurs that must be reported to the user log, ie *
- * it is used by almost all of the procedures. *
- * Notice how part of the error message is reported using resources stored *
- * in the AFE resource fork (for err <0 and >-85). AFE includes some stan- *
- * dard strings for these errors, check them out with ResEdit to see if they *
- * fit in your error messages as well. They are in the STR# ID=150 resource * *
- ****************************************************************************}
- Procedure ReportErr(err,doing : integer; statRec : statHndl; trnPB : trnPtr);
- { err = error code (usually a File manager code,
- doing = the action attempted that caused the error, one of the str_
- constants declared at the top of this unit }
- var
- Str : str255;
- oldres : integer;
- begin
- { save the AFE file ref number of the AFE resource file }
- oldres := curResFile;
- { use the translator resource file }
- useResFile(statRec^^.myFRef);
- GetIndString(str,statrec^^.myID,str_error);
- CallErrLog(str,false,true,trnPB^.trnlogproc);
- GetIndString(str,statrec^^.myID,doing);
- CallErrLog(str,false,true,trnPB^.trnlogproc);
- useResFile(oldres);
- { if appropriate use the error string from the AFE resource STR#150 }
- if (err < 0) and (err > -85)
- then GetIndString(str,150,-err)
- else GetIndString(str,150,5);
- CallErrLog(str,true,true,trnpb^.trnlogproc);
- end; { ReportErrLog }
-
- {********************************* TranStr **********************************
- * This is the function that provides the interaction between AFE and the *
- * translator. It ALWAYS has the SAME number and types of parameters. *
- * INPUT : Message - this integer describes the opertation requested by *
- * AFE for a complete listing of these operations see the *
- * constants under the "Conversion Routine Commands" heading *
- * TranslateData - this is either the default settings for this *
- * translator, or a handle to some global data the translator *
- * has allocated. *
- * Param - Varies with the message. Usually a pointer to info on *
- * source and destination files, or names of translated files. *
- * Self - this is a handle to the translation routine itself. *
- * It is used to lock the routine in memory while it is in use.*
- * OUTPUT : NONE *
- * RESULT : Varies with the message. Usually the status of a certain oper*
- * ation. If AFE does not explicitly require a result the tran-*
- * slator must return a zero. *
- ****************************************************************************}
- function TranStr(Message : integer; VAR translateData : Handle;
- Param : longint; Self : handle) : longint;
- var
- trnpb : trnPtr;
- statRec,statrec2 : statHndl;
- oldres : integer;
- h : handle;
- err : OSErr;
- begin
- hlock(self);
- trnpb := POINTER(Param);
- statRec := POINTER(translateData);
- case Message of
- trn_Init : begin
- TranStr := DoInit(translateData,self,trnpb);
- end;
-
- trn_Finis : begin
- TranStr := DoFinish(translateData);
- end;
-
- trn_Appear : begin
- TranStr := DoAppear(trnpb,statRec);
- end;
-
- trn_Disappear : begin
- {* trn_DISAPPEAR cleans up any global variables that might have
- * been allocated by trn_APPEAR. ALWAYS returns NoErr.
- *}
- TranStr := noerr;
- end;
-
- trn_Get : begin
- {* trn_GET returns the current status of this routine as the
- * function result.
- *}
- TranStr := statRec^^.myStatus;
- end;
-
- trn_Set : begin
- {* trn_SET sets the status flag of this routine using the
- * value in PARAM. The new status flag is returned as the
- * function result.
- *}
- statRec^^.myStatus := param;
- TranStr := param;
- end;
-
- trn_Active : begin
- TranStr := Activate(statRec,trnPB);
- end;
-
- trn_Inactive : begin
- {* trn_INACTIVE indicates that the user wishes to UNcheck this
- * menu item. The routine just clears the active bit in the
- * flags, and then returns the new status flag as the
- * function result.
- *}
- statRec^^.myStatus := band(statRec^^.myStatus,-1-trnActive);
- TranStr := statRec^^.myStatus;
- end;
-
- trn_Recognize : begin
- TranStr := RecogFile(statRec,trnpb);
- end;
-
- trn_NewName : begin
- TranStr := DoName(statRec,trnpb);
- end;
-
- trn_File : begin
- {* trn_FILE is passed a trnPTR in PARAM. It should check
- * the file specified as the source and return either NOERR
- * or UNACCEPT as the function result, depending on whether
- * the file matches the criteria for acceptance by this
- * routine. If acceptable, then trn_FILE should do the actual
- * translations, using the name (or possibly names) specified
- * in the name handle. Any errors encountered during translations
- * should be reported to the user log. Periodically, the
- * status procedure should be called with a (possibly empty)
- * status message and a number between 0 and 100 indicating
- * the percentage complete. This routine will return TRUE
- * most of the time, but can return FALSE if the user has
- * pressed the CANCEL button on the status panel. Because the
- * user can press CANCEL, it is requested that trn_FILE call
- * the status procedure as often as necessary to achieve some
- * measure of reasonable feedback.
- *}
- TranStr := DoFileConvert(statRec,trnpb);
- end;
- trn_Load : begin
- {*
- * Do a GETRESOURCE for all of the resources that you might
- * need during a translation. This does not guarantee that
- * a "floppy shuffle" won't be needed, just helps the odds.
- * Load the most likely to be used resources last so they will
- * be the least likely to be purged.
- *}
- oldres := curResFile;
- useResFile(statrec^^.myFRef);
- h := getResource('ICON',statrec^^.myID);
- h := getResource('ICON',statrec^^.myID+1);
- h := getResource('ICON',statrec^^.myID+2);
- h := getResource('ICON',statrec^^.myID+3);
- h := getResource('DITL',statrec^^.myID);
- h := getResource('DLOG',statrec^^.myID);
- h := getResource('STR#',statrec^^.myID);
- useResFile(oldres);
- { don't bother bringing in the ABOUT text }
- TranStr := 0;
- end;
- trn_About : begin
- {*
- * If we want to tell the user about ourselves, we can put up
- * our own dialog (in which case we return zero). If we want
- * nothing done, we can return -1, whereupon Apple File Exch will
- * inform the user that no information is available.
- * If we want Apple File Exch to display the information, we can give
- * it a (positive) resource ID of a TEXT resource containing
- * information about us.
- *}
- TranStr := statrec^^.myID;
- end;
- trn_GetSettings : begin
- {*
- * With this message, Apple File Exch is requesting a handle filled
- * with data that can be stored in a document. Apple File
- * Exchange allows the user to save and restore default settings
- * ("preferences", if you will) so that the user can launch
- * the program and have each translation be in a state that
- * they are familiar with. We have to do the NEWHANDLE call
- * to create a handle of the correct size, Apple File Exch will
- * dispose it later. If this call is not supported, return
- * NIL or some (negative) error code.
- *}
- h := translateData;
- { Create a new handle that points to a COPY of the global data }
- err := HandToHand(h); { see Inside Mac vol II, p374 for details }
- if err = noerr
- then TranStr := ORD4(h)
- else TranStr := err;
- end;
- trn_SetSettings : begin
- {*
- * With this message, Apple File Exch is passing a handle filled
- * with data that indicates a default setting. Apple File Exchange
- * allows the user to save and restore default settings
- * ("preferences", if you will) so that the user can launch
- * the program and have each translation be in a state that
- * they are familiar with. Apple File Exch will dispose of this
- * handle later (do not do so yourself). If this call is
- * not supported, return NIL or some (negative) error code.
- *}
- h := POINTER(param);
- { If for some reason AFE does not send a pointer to the correct
- data then do not change the current set up }
- if GetHandleSize(h) <> sizeof(statusRec) then TranStr := 0
- else with statrec^^ do begin
- statrec2 := POINTER(h);
- mystatus := statrec2^^.mystatus;
- ftype := statrec2^^.ftype;
- fkind := statrec2^^.fkind;
- end;
- end;
- end;
- hunlock(self);
- hpurge(self);
- end;
-
- end.